home *** CD-ROM | disk | FTP | other *** search
/ Web Designer 98 (Professional) / WebDesigner 1.0.iso / toolbox / vb5ccein.exe / Marquee.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-10-24  |  12.0 KB  |  346 lines
  1. VERSION 5.00
  2. Begin VB.UserControl AXMarquee 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H8000000D&
  6.    ClientHeight    =   2736
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   4608
  10.    PropertyPages   =   "Marquee.ctx":0000
  11.    ScaleHeight     =   228
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   384
  14.    ToolboxBitmap   =   "Marquee.ctx":0011
  15.    Begin VB.PictureBox picBlankCol 
  16.       Appearance      =   0  'Flat
  17.       AutoSize        =   -1  'True
  18.       BackColor       =   &H80000005&
  19.       BorderStyle     =   0  'None
  20.       ForeColor       =   &H80000008&
  21.       Height          =   552
  22.       Left            =   420
  23.       Picture         =   "Marquee.ctx":010B
  24.       ScaleHeight     =   46
  25.       ScaleMode       =   3  'Pixel
  26.       ScaleWidth      =   5
  27.       TabIndex        =   2
  28.       Top             =   672
  29.       Visible         =   0   'False
  30.       Width           =   60
  31.    End
  32.    Begin VB.PictureBox picCaps 
  33.       Appearance      =   0  'Flat
  34.       AutoSize        =   -1  'True
  35.       BackColor       =   &H80000005&
  36.       BorderStyle     =   0  'None
  37.       ForeColor       =   &H80000008&
  38.       Height          =   432
  39.       Left            =   -2148
  40.       Picture         =   "Marquee.ctx":06BD
  41.       ScaleHeight     =   28.8
  42.       ScaleMode       =   0  'User
  43.       ScaleWidth      =   711.68
  44.       TabIndex        =   1
  45.       Top             =   2130
  46.       Width           =   10680
  47.    End
  48.    Begin VB.PictureBox picMsg 
  49.       Appearance      =   0  'Flat
  50.       AutoRedraw      =   -1  'True
  51.       BackColor       =   &H80000005&
  52.       BorderStyle     =   0  'None
  53.       ForeColor       =   &H80000008&
  54.       Height          =   540
  55.       Left            =   0
  56.       ScaleHeight     =   45
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   98
  59.       TabIndex        =   0
  60.       Top             =   1485
  61.       Width           =   1170
  62.    End
  63.    Begin VB.Timer tAni 
  64.       Enabled         =   0   'False
  65.       Interval        =   50
  66.       Left            =   204
  67.       Top             =   156
  68.    End
  69. Attribute VB_Name = "AXMarquee"
  70. Attribute VB_GlobalNameSpace = False
  71. Attribute VB_Creatable = True
  72. Attribute VB_PredeclaredId = False
  73. Attribute VB_Exposed = True
  74. Attribute VB_Description = "ActiveX Marquee Control"
  75. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  76. Option Explicit
  77. Enum ScrollModeValue
  78.   R_to_L = 0
  79.   L_to_R = 1
  80. End Enum
  81. 'Vars for tracking BMP size and position
  82. Private lBMPWidth   As Long     'Total width of the Message Bitmap to be drawn on the background
  83. Private bRestart    As Boolean
  84. Private lCtlWidth   As Long     'Corrected bitmap width for drawing - rounded up to multiple of 5
  85. 'Y position of where the Message Bitmap will be drawn on the background
  86. Const SRC_Y = 0
  87. 'Height of the control - don't allow it to change
  88. Const CTL_HEIGHT = 683    'Twips
  89. 'Default Property Values:
  90. Const m_def_ScrollMode = R_to_L
  91. Const m_def_Text = "ActiveX Marquee"
  92. Const m_def_Scrolling = False
  93. 'Property Variables:
  94. Dim m_ScrollMode As ScrollModeValue   'Tracks which direction the control scrolls from.
  95. Dim m_Text As String                  'Holds the message text to be displayed.
  96. Dim m_Scrolling As Boolean               'Tracks whether Scrolling is enabled or disabled.
  97. Private Sub tAni_Timer()
  98.   Static lX           As Long   'Absolute X postion to track message bitmap
  99.   Static lX2          As Long   'X position on the control to draw the message
  100.   Static lSrcOffset   As Long   'Offset into the Message bitmap
  101.   Static lSrcWidth    As Long   'Width from the offset in the Message bitmap to draw
  102.   If bRestart Then
  103.     'Determine which side to scroll from
  104.     If m_ScrollMode = R_to_L Then
  105.       'Scroll Right to Left
  106.       lX = lCtlWidth - BULB_WIDTH
  107.       lSrcOffset = 0
  108.       lSrcWidth = BULB_WIDTH
  109.     Else
  110.       'Assume scroll Left to Right
  111.       lX = BULB_WIDTH
  112.       lSrcOffset = BULB_WIDTH
  113.       lSrcWidth = BULB_WIDTH
  114.     End If
  115.     bRestart = False
  116.   End If  'If bRestart
  117.   If m_ScrollMode = R_to_L Then
  118.     If lX > 0 Then
  119.       lX2 = lX
  120.       If lCtlWidth - lX <= lBMPWidth Then
  121.         lSrcWidth = lCtlWidth - lX
  122.       Else
  123.         lSrcWidth = lBMPWidth
  124.       End If
  125.     Else ' assume lx <= 0
  126.       lX2 = 0
  127.       lSrcOffset = Abs(lX)
  128.       lSrcWidth = lBMPWidth - lSrcOffset
  129.     End If
  130.   Else  'Assume m_ScrollMode = L_to_R
  131.     If lX < lCtlWidth Then
  132.       If lX <= lBMPWidth Then
  133.         lX2 = 0
  134.         lSrcWidth = lX
  135.         lSrcOffset = lBMPWidth - lX
  136.       Else
  137.         lX2 = lX2 + BULB_WIDTH
  138.         lSrcWidth = lBMPWidth
  139.         lSrcOffset = 0
  140.       End If
  141.     Else  'assume lx >= lctlwidth
  142.       If lX > lBMPWidth Then
  143.         lX2 = lX2 + BULB_WIDTH
  144.         lSrcWidth = lBMPWidth
  145.       Else
  146.         lSrcOffset = lBMPWidth - lX
  147.         lSrcWidth = lCtlWidth
  148.       End If
  149.     End If
  150.   End If
  151.   UserControl.PaintPicture picMsg.Picture, lX2, SRC_Y, , , _
  152.                            lSrcOffset, , lSrcWidth, , _
  153.                            vbSrcCopy
  154.   If m_ScrollMode = R_to_L Then
  155.     If lSrcOffset + BULB_WIDTH = lBMPWidth Then
  156.       bRestart = True
  157.     Else
  158.       lX = lX - BULB_WIDTH
  159.     End If
  160.   Else  'Assume m_ScrollMode = L_to_R
  161.     If lX2 + BULB_WIDTH = lCtlWidth Then
  162.       bRestart = True
  163.     Else
  164.       lX = lX + BULB_WIDTH
  165.     End If
  166.   End If
  167. End Sub
  168. Private Sub UserControl_Initialize()
  169.   InitBMPStruct
  170. End Sub
  171. 'Initialize Properties for User Control
  172. Private Sub UserControl_InitProperties()
  173.   m_ScrollMode = m_def_ScrollMode
  174.   m_Text = m_def_Text
  175.   m_Scrolling = m_def_Scrolling
  176. End Sub
  177. 'Load property values from storage
  178. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  179.   ScrollMode = PropBag.ReadProperty("ScrollMode", m_def_ScrollMode)
  180.   Text = PropBag.ReadProperty("Text", m_def_Text)
  181.   Scrolling = PropBag.ReadProperty("Scrolling", m_def_Scrolling)
  182. End Sub
  183. 'Write property values to storage
  184. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  185.   Call PropBag.WriteProperty("ScrollMode", m_ScrollMode, m_def_ScrollMode)
  186.   Call PropBag.WriteProperty("Text", m_Text, m_def_Text)
  187.   Call PropBag.WriteProperty("Scrolling", m_Scrolling, m_def_Scrolling)
  188. End Sub
  189. Private Sub UserControl_Resize()
  190.   'Don't allow the control to change height
  191.   UserControl.Height = CTL_HEIGHT
  192.   'Determine the closest LED to begin drawing from
  193.   lCtlWidth = UserControl.ScaleWidth - UserControl.ScaleWidth Mod 5
  194.   'Repaint the unlit LED grid
  195.   DrawBackground
  196. End Sub
  197. Public Property Get Text() As String
  198. Attribute Text.VB_Description = "Text string to display on the marquee"
  199. Attribute Text.VB_ProcData.VB_Invoke_Property = ";Text"
  200.   Text = m_Text
  201. End Property
  202. Public Property Let Text(ByVal New_Text As String)
  203.   m_Text = New_Text
  204.   PropertyChanged "Text"
  205.   'Force a reset of the Timer painting code since the direction changed.
  206.   If m_Scrolling Then
  207.     tAni.Enabled = False
  208.     bRestart = True
  209.     DrawBackground
  210.     BuildTheBmp (m_Text)
  211.     tAni.Enabled = True
  212.   Else
  213.     tAni.Enabled = False
  214.     bRestart = False
  215.   End If
  216. End Property
  217. Public Property Get Scrolling() As Boolean
  218. Attribute Scrolling.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  219. Attribute Scrolling.VB_ProcData.VB_Invoke_Property = ";Behavior"
  220.   Scrolling = m_Scrolling
  221. End Property
  222. Public Property Let Scrolling(ByVal bScrolling As Boolean)
  223.   m_Scrolling = bScrolling
  224.   PropertyChanged "Scrolling"
  225.   If m_Scrolling Then
  226.     DrawBackground
  227.     BuildTheBmp (m_Text)
  228.     tAni.Enabled = True
  229.   Else
  230.     tAni.Enabled = False
  231.     bRestart = False
  232.   End If
  233. End Property
  234. Public Property Get ScrollMode() As ScrollModeValue
  235.   ScrollMode = m_ScrollMode
  236. End Property
  237. Public Property Let ScrollMode(ByVal New_ScrollMode As ScrollModeValue)
  238.   m_ScrollMode = New_ScrollMode
  239.   PropertyChanged "ScrollMode"
  240.   'Force a reset of the Timer painting code since the direction changed.
  241.   If m_Scrolling Then
  242.     tAni.Enabled = False
  243.     bRestart = True
  244.     DrawBackground
  245.     BuildTheBmp (m_Text)
  246.     tAni.Enabled = True
  247.   Else
  248.     tAni.Enabled = False
  249.     bRestart = False
  250.   End If
  251. End Property
  252. Private Sub DrawBackground()
  253.   Dim lColX As Long
  254.   With UserControl
  255.         
  256.     'Turn this on so that what is drawn becomes part of the UserControl's picture.
  257.     .AutoRedraw = True
  258.     For lColX = 0 To .ScaleWidth Step 5  'Unlit columns are 5 pixels wide
  259.       .PaintPicture picBlankCol.Picture, lColX, 0, _
  260.                     aCharSpace.Width, , _
  261.                     aCharSpace.Left, 0, _
  262.                     aCharSpace.Width
  263.     Next lColX
  264.     'Turn off so painting performance is faster
  265.     .AutoRedraw = False
  266.   End With 'UserControl
  267. End Sub
  268. Private Function BuildTheBmp(sText As String) As Long
  269.   Dim lChar     As Long     'Character in the string that we are working on.
  270.   Dim lOffset   As Long     'Tracks the offset into the destination bitmap.
  271.   Dim lCharVal  As Long     'Value of the character at the current offset.
  272.   Dim lCounter  As Long     'Temp counter
  273.   Dim lMsgLength As Long    'Length of the message string
  274.   'No support for lower case yet...  Convert all msgs to uppercase.
  275.   sText = UCase$(sText)
  276.   lMsgLength = Len(sText)
  277.   With picMsg
  278.     'Set to true so the drawing will become part of the picture property.
  279.     .AutoRedraw = True
  280.     'Calculating the width of the picture first by accessing the array values in memory is
  281.     'much faster than setting the .Width property each time through the loops below.
  282.     For lChar = 1 To lMsgLength
  283.       lCharVal = Asc(Mid$(sText, lChar, 1))
  284.       If lCharVal = 32 Then 'A space
  285.         For lCounter = 1 To 4
  286.           lOffset = lOffset + aCharSpace.Width
  287.         Next lCounter
  288.       
  289.       ElseIf lCharVal >= 65 And lCharVal <= 90 Then
  290.         lOffset = lOffset + aChars(lCharVal).Width  'Make the Picture wide enough to handle the bitmap
  291.       End If
  292.       
  293.     Next lChar
  294.     'Set the picture control to the total width of the message to be created.
  295.     .Width = lOffset + aCharSpace.Width
  296.     lOffset = 0
  297.     For lChar = 1 To lMsgLength
  298.       
  299.       'Get the ASCII value of the character - This is the index into the bmp array.
  300.       lCharVal = Asc(Mid$(sText, lChar, 1))
  301.       
  302.       If lCharVal = 32 Then 'A space
  303.       
  304.         For lCounter = 1 To 4
  305.           .PaintPicture picCaps.Picture, lOffset, 0, _
  306.                         aCharSpace.Width, , _
  307.                         aCharSpace.Left, 0, _
  308.                         aCharSpace.Width
  309.           
  310.           lOffset = lOffset + aCharSpace.Width
  311.         Next lCounter
  312.               
  313.       ElseIf lCharVal >= 65 And lCharVal <= 90 Then
  314.             
  315.         'Paint the region conaining the desired character onto the Msg picturebox at
  316.         'at offset lOffset.
  317.         .PaintPicture picCaps.Picture, lOffset, 0, _
  318.                       aChars(lCharVal).Width, , _
  319.                       aChars(lCharVal).Left, 0, _
  320.                       aChars(lCharVal).Width
  321.                       
  322.         'Increment lOffset by the width of the last Bmp painted on the Msg picturebox.
  323.         lOffset = lOffset + aChars(lCharVal).Width
  324.       
  325.       Else
  326.         Debug.Print "Unsupported character entered - " & Mid$(sText, lChar, 1) & "ASCII = " & Asc(Mid$(sText, lChar, 1))
  327.       
  328.       End If
  329.       
  330.     Next lChar
  331.     'Add a blank row of LEDs to the end of the message
  332.     .PaintPicture picCaps.Picture, lOffset, 0, _
  333.                   aCharSpace.Width, , _
  334.                   aCharSpace.Left, 0, _
  335.                   aCharSpace.Width
  336.                   
  337.     lOffset = lOffset + aCharSpace.Width
  338.     'Now that we're done drawing turn this off for better paint performance.
  339.     .AutoRedraw = False
  340.     .Picture = picMsg.Image
  341.   End With  'picMsg
  342.     lBMPWidth = lOffset
  343.   BuildTheBmp = 0
  344.   bRestart = True
  345. End Function
  346.